home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / tu32.zip / TU32DEMO / PROJTU / TUMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1996-11-08  |  9KB  |  281 lines
  1. unit Tumain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DB, StdCtrls, ExtCtrls, DbiTypes, DBIErrs,
  8.   DBGrids, DBTables, Tu, VwErrDlg, Rebdlg, Verdlg, Grids;
  9.  
  10. type
  11.   TFormTUMain = class(TForm)
  12.     Panel1: TPanel;
  13.     GroupBoxSelectTable: TGroupBox;
  14.     OpenDialog1: TOpenDialog;
  15.     EditFileName: TEdit;
  16.     ButtonBrowse: TButton;
  17.     GroupBoxViewInfo: TGroupBox;
  18.     GroupBoxRepairTable: TGroupBox;
  19.     ButtonClose: TButton;
  20.     ButtonHelp: TButton;
  21.     ButtonVerify: TButton;
  22.     ButtonRebuild: TButton;
  23.     Label1: TLabel;
  24.     Label2: TLabel;
  25.     Label3: TLabel;
  26.     Label4: TLabel;
  27.     Label5: TLabel;
  28.     LabelRecSize: TLabel;
  29.     LabelNumFields: TLabel;
  30.     LabelNumRecs: TLabel;
  31.     LabelNumAuxPasswords: TLabel;
  32.     LabelPasswordTF: TLabel;
  33.     TUtility1: TTUtility;
  34.     VerifyDlg1: TVerifyDlg;
  35.     RebuildDlg1: TRebuildDlg;
  36.     ButtonBorrowStructure: TButton;
  37.     procedure FormCreate(Sender: TObject);
  38.     procedure ButtonBrowseClick(Sender: TObject);
  39.     procedure ButtonBorrowStructureClick(Sender: TObject);
  40.     procedure EditFileNameExit(Sender: TObject);
  41.     procedure ButtonVerifyClick(Sender: TObject);
  42.     procedure ButtonCloseClick(Sender: TObject);
  43.     procedure ButtonRebuildClick(Sender: TObject);
  44.   private
  45.     { Private declarations }
  46.     FileStructBorrowed : Boolean;
  47.     procedure EnableButtons(TurnOn : Boolean);
  48.     procedure DeleteErrorTable;
  49.     Procedure ShowTableStats(TblInfoRec : TTableInfo);
  50.   public
  51.     { Public declarations }
  52.   end;
  53.  
  54. var
  55.   FormTUMain: TFormTUMain;
  56.  
  57. implementation
  58.  
  59. {$R *.DFM}
  60.  
  61. procedure TFormTUMain.FormCreate(Sender: TObject);
  62. begin
  63.   { Make sure the rebuild and verify buttons are greyed to start}
  64.   EnableButtons(False);
  65. end;
  66.  
  67. procedure TFormTUMain.EnableButtons(TurnOn : Boolean);
  68. begin
  69.   if TurnOn then
  70.   begin
  71.     ButtonBorrowStructure.Enabled := True;
  72.     ButtonVerify.Enabled  := True;
  73.     { Only turn on the Rebuild button if the header is not damaged
  74.       this is a very consertive approach }
  75.     if TUtility1.TblInfo.bValidInfo then
  76.       ButtonRebuild.Enabled := True
  77.     else
  78.       ButtonRebuild.Enabled := False;
  79.   end
  80.   else
  81.   begin
  82.     ButtonVerify.Enabled  := False;
  83.     ButtonRebuild.Enabled := False;
  84.   end;
  85. end;
  86.  
  87. procedure TFormTUMain.DeleteErrorTable;
  88. Var
  89.   ErrTblName : String;
  90. begin
  91.   { make sure the error table is not active }
  92.   BtnBottomDlg.TableErrTable.Active := False;
  93.   {Make sure the error table name has an extension }
  94.   if extractFileExt(BtnBottomDlg.TableErrTable.TableName) = '' then
  95.     ErrTblName := BtnBottomDlg.TableErrTable.TableName + '.DB'
  96.   else
  97.     ErrTblName := BtnBottomDlg.TableErrTable.TableName;
  98.   {if the error table  does not have a path then assign the private one}
  99.   if extractFilePath(BtnBottomDlg.TableErrTable.TableName) = '' then
  100.     ErrTblName := Session.PrivateDir + '\' + ErrTblName;
  101.   {Now delete the table if it exists}
  102.   if fileexists(ErrTblName) then
  103.     BtnBottomDlg.TableErrTable.DeleteTable;
  104. end;
  105.  
  106. Procedure TFormTUMain.ShowTableStats(TblInfoRec : TTableInfo);
  107. { This method desplays useful information about the table being fixed
  108.   on the form }
  109. begin
  110.   {Only change the displayed rec count if it's the table being fixed.
  111.    If this is data from a borrowed structure then leave the rec count
  112.    alone.}
  113.   if not FileStructBorrowed then
  114.     LabelNumRecs.Caption       := InttoStr(TblInfoRec.iRecords);
  115.   LabelRecSize.Caption         := IntToStr(TblInfoRec.iRecSize);
  116.   LabelNumFields.Caption       := IntToStr(TblInfoRec.iFields);
  117.   LabelNumAuxPasswords.Caption := IntToStr(TblInfoRec.iPasswords);
  118.   if TblInfoRec.bProtected then
  119.     LabelPasswordTF.Caption := 'True'
  120.   else
  121.     LabelPasswordTF.Caption := 'False'
  122. end;
  123.  
  124. procedure TFormTUMain.ButtonBrowseClick(Sender: TObject);
  125. begin
  126.  {Delete the error table so it doesn't show up in the list}
  127.  DeleteErrorTable;
  128.  { reset the FileStructBorrowed flag}
  129.  FileStructBorrowed := False;
  130.  { Display the file selection dialog }
  131.  OpenDialog1.Execute;
  132.  Try
  133.    { Set the TableName Name property for the TUtility to be checked for corruption }
  134.    { If you set things in the following order error checking is complete }
  135.    TUtility1.TableName := OpenDialog1.FileName;
  136.    EditFileName.Text := TUtility1.TableName;
  137.    { Display file stats }
  138.    ShowTableStats(TUtility1.TblInfo);
  139.  Finally
  140.    If FileExists(TUtility1.TableName) then
  141.      {Activate the verify and rebuild buttons Show even if setting Table Erred}
  142.      EnableButtons(true)
  143.    else
  144.      EnableButtons(false);
  145.  end;
  146. end;
  147.  
  148. procedure TFormTUMain.ButtonBorrowStructureClick(Sender: TObject);
  149. begin
  150.   { Display the file selection dialog }
  151.   OpenDialog1.Execute;
  152.   Try
  153.     { Set AltStructName to the file we borrow the structure from}
  154.     TUtility1.AltStructName := ExpandFileName(OpenDialog1.FileName);
  155.     { Make sure the header for the borrowed structure table is not damaged}
  156.     { Remember that assigning a table to AltStructName automatically
  157.       verifies its header so you can imediately check iErrorLevel}
  158.     If (TUtility1.iErrorLevel > 0) or
  159.        Not(TUtility1.AltTblInfo.bValidInfo) then
  160.     begin
  161.       MessageDlg('The table you choose to borrow the structure from ' +
  162.                  'is probably corrupt. Use a different table!',
  163.                  mtWarning, [mbOk], 0);
  164.       TUtility1.AltStructName := '';
  165.     end
  166.     else
  167.     begin
  168.       {Set the FileStructBorrowed flag }
  169.       FileStructBorrowed := True;
  170.       { enable the Rebuild button }
  171.       ButtonRebuild.Enabled := True;
  172.     end;
  173.   finally
  174.     if not fileexists(TUtility1.AltStructName) then
  175.     begin
  176.       ButtonRebuild.Enabled := False;
  177.       FileStructBorrowed := False;
  178.     end;
  179.     ShowTableStats(TUtility1.AltTblInfo);
  180.   end;
  181. end;
  182.  
  183. procedure TFormTUMain.EditFileNameExit(Sender: TObject);
  184. begin
  185.  if EditFileName.Text = '' then exit;
  186.  Try
  187.    { Delete the error table if a new table has been selected }
  188.    if ExtractFileName(Tutility1.TableName) <>
  189.       ExtractFileName(EditFileName.Text) then
  190.      DeleteErrorTable;
  191.    { Set the TableName Name property for the TUtility to be checked for corruption }
  192.    TUtility1.TableName := ExpandFileName(EditFileName.Text);
  193.    { Display file stats }
  194.    ShowTableStats(TUtility1.TblInfo);
  195.    {enable the buttons}
  196.    EnableButtons(true);
  197.  Except
  198.    EnableButtons(False);
  199.    raise;
  200.  end;
  201. end;
  202.  
  203. procedure TFormTUMain.ButtonVerifyClick(Sender: TObject);
  204. begin
  205.   { Delete the ErrorTable if it exists }
  206.   DeleteErrorTable;
  207.   { run the Verify }
  208.   TUtility1.ExecuteVerify;
  209.   { Show completion status messages }
  210.   if TUtility1.ierrorLevel <> 0 then
  211.   begin
  212.     if MessageDlg('The table is corrupt and must be repaired! ' +
  213.                   #10#13 + 'Do you want to view the problems?',
  214.                  mtWarning, [mbYes, mbNo], 0) = mrYes then
  215.     begin
  216.       { open the table }
  217.       BtnBottomDlg.TableErrTable.DatabaseName := Session.PrivateDir;
  218.       BtnBottomDlg.TableErrTable.Active := True;
  219.       BtnBottomDlg.ShowModal;
  220.       { Deactivate Error Table }
  221.       BtnBottomDlg.TableErrTable.Active := False;
  222.       {Now depending on the situation Show the rebuild button}
  223.       {There is a very high probability an autoerebuild will work if
  224.        the error is 1 or 2 and the bValidInfo field is true}
  225.       If (TUtility1.ierrorLevel < 3) then
  226.         ButtonRebuild.Enabled := True
  227.       else if TUtility1.ierrorLevel = 3 then
  228.          MessageDlg('The cannot be automatically rebuilt.' +
  229.                 #10#13 + 'Do you want to view the problems?',
  230.                mtWarning, [mbOK], 0)
  231.       else if (TUtility1.ierrorLevel = 4) then
  232.       begin
  233.         MessageDlg('BAD NEWS! The cannot be rebuilt.' +
  234.                 #10#13 + 'Reload from backups.',
  235.                mtInformation, [mbOK], 0);
  236.         ButtonBorrowStructure.Enabled := False;
  237.       end;
  238.     end;
  239.   end
  240.   else {everythings cool}
  241.   begin
  242.     MessageDlg('GOOD NEWS!' + #10#13 + 'Header and Data are O.K.',
  243.                  mtInformation, [mbOK], 0);
  244.   end;
  245. end;
  246.  
  247. procedure TFormTUMain.ButtonCloseClick(Sender: TObject);
  248. begin
  249.   {clean up when the app ends by deleting the error table}
  250.   DeleteErrorTable;
  251.   close;
  252. end;
  253.  
  254. procedure TFormTUMain.ButtonRebuildClick(Sender: TObject);
  255. var
  256.   pTableDesc : pCRTblDesc;
  257. begin
  258.   {Hold on to your hats}
  259.   { Determine if and where to get the table structure information }
  260.   { ** Situation #1 : Go for the autorebuild }
  261.   If (TUtility1.iErrorLevel < 3) and not(FileStructBorrowed) then
  262.     pTableDesc := TUtility1.pCurrentTblDesc {get the automatic table description}
  263.   { ** Situation #2 : Specify the file structure your self}
  264.   else if (TUtility1.iErrorLevel < 4) and FileStructBorrowed then
  265.     {In this case you must roll your own Table description}
  266.     { select an alternate file by simulating a Borrow Structure button click}
  267.     pTableDesc := TUtility1.pAltTblDesc {get the alternate table description}
  268.   else { ** Situation #3 : A Real Bummer }
  269.   begin
  270.     MessageDlg('BAD NEWS! The cannot be rebuilt.' + #10#13 +
  271.                'Reload from backups.',  mtInformation, [mbOK], 0);
  272.     exit;               {Can't rebuild so Bail out }
  273.   end;
  274.   { Here's where the rebuild actually happens }
  275.   Tutility1.ExecuteRebuild(pTableDesc);
  276.   MessageDlg('Table Successfully rebuild!', mtInformation, [mbOK], 0);
  277. end;
  278.  
  279. end.
  280.  
  281.